home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / uobj.com / UOBJ.QP < prev   
Encoding:
Text File  |  1990-01-10  |  2.3 KB  |  95 lines
  1. unit UObj;               {Quick Pascal Version}              {90/01/10}
  2. {
  3.    This unit contains the TObj class and was written to:
  4.  
  5.      1) provide a "better" base object for Turbo Pascal programmers
  6.      2) enhance portability between Object Pascal and Turbo Pascal (MS/DOS)
  7.      3) provide the standard base object to Quick Pascal programmers
  8.  
  9.    Author: Mike Babulic                   Compuserve: 72307,314
  10.            3827 Charleswood Dr. N.W.
  11.            Calgary, Alberta
  12.            Canada
  13.            T2L 2C7
  14. }
  15. interface
  16.  
  17.   type
  18.     TObj = object
  19.       function    Clone: Pointer;
  20.               {Copies SELF and returns a pointer to the copy
  21.              Can override to copy objects referred to by
  22.              fields of SELF}
  23.       procedure   Free;
  24.               {Frees SELF from the heap.
  25.              Can override to free objects referred to by
  26.              fields of SELF}
  27.       function    ShallowClone: Pointer;
  28.               {Low-level copy; should not be overridden
  29.              except in very unusual cases}
  30.       procedure   ShallowFree;
  31.               {Low-level method for freeing an object.
  32.              Should not be overridden
  33.              except in very unusual cases}
  34.       function    Bytes:Longint;
  35.               {Returns the number of bytes in SELF}
  36.       function    TypeOf:Pointer;
  37.               {Returns TypeOf(SELF)}
  38.       end;
  39.  
  40.     TObject = TObj;   {For compatability with Object Pascal programs}
  41.  
  42. implementation
  43.  
  44.   type
  45.  
  46.     pClass = ^Class;
  47.     Class = record
  48.       IsThisParentOrMethodsOrSomethingElse : pClass;
  49.       SizeOf : Word;
  50.       end;
  51.  
  52.     pObject = ^rObject;
  53.     rObject = record
  54.       tag : pClass;
  55.       data: integer;
  56.       end;
  57.  
  58.     function TObject.ShallowClone: Pointer;
  59.       var t:Pointer;
  60.       begin
  61.     t := nil;
  62.     GetMem(t,SELF.Bytes);
  63.     Move(pointer(self)^,t^,SELF.Bytes);
  64.     ShallowClone := t;
  65.       end;
  66.  
  67.     procedure TObject.ShallowFree;
  68.       var t:Pointer;
  69.       begin
  70.     t := SELF;
  71.     FreeMem(t,SELF.Bytes);
  72.       end;
  73.  
  74.     function TObject.Clone: Pointer;
  75.       begin
  76.     Clone := SELF.ShallowClone;
  77.       end;
  78.  
  79.     procedure TObject.Free;
  80.       begin
  81.     SELF.ShallowFree;
  82.       end;
  83.  
  84.     function TObject.Bytes:Longint;
  85.       begin
  86.     Bytes := pObject(SELF)^.tag^.SizeOf;
  87.       end;
  88.  
  89.     function TObject.TypeOf:Pointer;
  90.       begin
  91.     TypeOf := pObject(SELF)^.tag;
  92.       end;
  93.  
  94.   end.
  95.